Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vbnets/cti_nets.bas

BASIC Source File | 1996-06-12 | 15.2 KB | 381 lines

Option Explicit

' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.

Declare Function WNetGetConnection Lib "User" (ByVal LocalDev As String, ByVal rmtname As String, buffsize As Integer) As Integer
Declare Function WNetAddConnection Lib "User" (ByVal NetPath As String, ByVal PassWord As String, ByVal LocalDev As String) As Integer
Declare Function WNetCancelConnection Lib "User" (ByVal LocalDev As String, ByVal Force As Integer) As Integer
Declare Function WNetGetUser Lib "User" (ByVal szUser As String, lpnBufferSize As Integer) As Integer
Declare Function WNetGetCaps Lib "User" (ByVal nFlags As Integer) As Integer
Declare Function MNetNetworkEnum Lib "WFWNET.DRV" (lpnSubnet As Integer) As Integer
Declare Function MNetSetNextTarget Lib "WFWNET.DRV" (ByVal lpnSubnet As Integer) As Integer

Global Const WN_SUCCESS = &H0
Global Const WN_NOT_SUPPORTED = &H1
Global Const WN_NET_ERROR = &H2
Global Const WN_MORE_DATA = &H3
Global Const WN_BAD_POINTER = &H4
Global Const WN_BAD_VALUE = &H5
Global Const WN_BAD_PASSWORD = &H6
Global Const WN_ACCESS_DENIED = &H7
Global Const WN_FUNCTION_BUSY = &H8
Global Const WN_WINDOWS_ERROR = &H9
Global Const WN_BAD_USER = &HA
Global Const WN_OUT_OF_MEMORY = &HB
Global Const WN_CANCEL = &HC
Global Const WN_CONTINUE = &HD
Global Const WN_NOT_CONNECTED = &H30
Global Const WN_OPEN_FILES = &H31
Global Const WN_BAD_NETNAME = &H32
Global Const WN_BAD_LOCALNAME = &H33
Global Const WN_ALREADY_CONNECTED = &H34
Global Const WN_DEVICE_ERROR = &H35
Global Const WN_CONNECTION_CLOSED = &H36

' Open file handling constants
Global Const NET_OPENDISALLOW = 1
Global Const NET_OPENQUERY = 2
Global Const NET_OPENIGNORE = 3

Function UT_GetNetworkType () As String

' Copyright ⌐ 1994 by Computer Technologies, Inc. All rights reserved.

' When WNetGetCaps is called with the flag WNNC_NET_TYPE it returns a
' network type bit mask. The high byte contains the network type, and
' the low byte may contain a subtype. The network type can be one of
' the following values:
    Const WNNC_NET_NONE = &H0
    Const WNNC_NET_MSNet = &H100
    Const WNNC_NET_LanMan = &H200
    Const WNNC_NET_NetWare = &H300
    Const WNNC_NET_Vines = &H400
    Const WNNC_NET_10NET = &H500
    Const WNNC_NET_Locus = &H600
    Const WNNC_NET_SunPCNFS = &H700
    Const WNNC_NET_LANstep = &H800
    Const WNNC_NET_9TILES = &H900
    Const WNNC_NET_LANtastic = &HA00
    Const WNNC_NET_AS400 = &HB00
    Const WNNC_NET_FTP_NFS = &HC00
    Const WNNC_NET_PATHWORKS = &HD00
    Const WNNC_NET_LifeNet = &HE00
    Const WNNC_NET_POWERLan = &HF00
    Const WNNC_NET_MultiNet = &H8000

    Const WNNC_SUBNET_NONE = &H0
    Const WNNC_SUBNET_MSNet = &H1
    Const WNNC_SUBNET_LanMan = &H2
    Const WNNC_SUBNET_WinWork = &H4
    Const WNNC_SUBNET_NetWare = &H8
    Const WNNC_SUBNET_Vines = &H10
    Const WNNC_SUBNET_Other = &H80

    Const WNNC_NET_TYPE = &H2

    Dim tTempStr            As String
    Dim nFlags              As Integer
    Dim nByteHi             As Integer
    Dim nByteLo             As Integer

    tTempStr = ""

    nFlags = WNetGetCaps(WNNC_NET_TYPE)     ' Get network type bit flags

    If (nFlags And WNNC_NET_NONE) Then tTempStr = "Network not installed or not running" & ", "
    If (nFlags And WNNC_NET_MSNet) Then tTempStr = "MSNet" & ", "
    If (nFlags And WNNC_NET_LanMan) Then tTempStr = "LanMan" & ", "
    If (nFlags And WNNC_NET_NetWare) Then tTempStr = "NetWare" & ", "
    If (nFlags And WNNC_NET_Vines) Then tTempStr = "Vines" & ", "
    If (nFlags And WNNC_NET_10NET) Then tTempStr = "10 NET" & ", "
    If (nFlags And WNNC_NET_Locus) Then tTempStr = "Locus" & ", "
    If (nFlags And WNNC_NET_SunPCNFS) Then tTempStr = "Sun PC NFS" & ", "
    If (nFlags And WNNC_NET_LANstep) Then tTempStr = "LANstep" & ", "
    If (nFlags And WNNC_NET_9TILES) Then tTempStr = "9 TILES" & ", "
    If (nFlags And WNNC_NET_LANtastic) Then tTempStr = "LANtastic" & ", "
    If (nFlags And WNNC_NET_AS400) Then tTempStr = "AS-400" & ", "
    If (nFlags And WNNC_NET_FTP_NFS) Then tTempStr = "FTP NFS" & ", "
    If (nFlags And WNNC_NET_PATHWORKS) Then tTempStr = "PATHWORKS" & ", "
    If (nFlags And WNNC_NET_LifeNet) Then tTempStr = "LifeNet" & ", "
    If (nFlags And WNNC_NET_POWERLan) Then tTempStr = "POWERLan" & ", "
    If (nFlags And WNNC_NET_MultiNet) Then  ' Multinet is a bit mask that identifies all the sub nets so check each one ...
    If (nFlags And WNNC_SUBNET_NONE) Then tTempStr = tTempStr & "None" & ", "
    If (nFlags And WNNC_SUBNET_MSNet) Then tTempStr = tTempStr & "MsNet" & ", "
    If (nFlags And WNNC_SUBNET_LanMan) Then tTempStr = tTempStr & "LanMan" & ", "
    If (nFlags And WNNC_SUBNET_WinWork) Then tTempStr = tTempStr & "Windows for Workgroups" & ", "
    If (nFlags And WNNC_SUBNET_NetWare) Then tTempStr = tTempStr & "NetWare" & ", "
    If (nFlags And WNNC_SUBNET_Vines) Then tTempStr = tTempStr & "Vines" & ", "
    If (nFlags And WNNC_SUBNET_Other) Then tTempStr = tTempStr & "Other" & ", "
    End If

    If Right$(tTempStr, 2) = ", " Then tTempStr = Left$(tTempStr, Len(tTempStr) - 2)

    UT_GetNetworkType = tTempStr

End Function

Function UT_NetDismount (tLocalName As String, nOpenFileAction As Integer) As Integer

' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.

' Inbound parameters:
'   tLocalName          - The drive letter to dismount
'   nOpenFileAction     - What to do if there are open files on the service

' Use one of the following defined constants for nOpenFileAction values:
'   NET_OPENDISALLOW    - Service can't be closed with open files
'   NET_OPENQUERY       - Warn the user that there are open files
'   NET_OPENIGNORE      - Ignore open files and force a dismount

' Return value:
'   True        - The service was dismounted
'   False       - The service was NOT dismounted

    Dim nResult1            As Integer
    Dim nResult2            As Integer
    Dim nAction             As Integer
    Dim bForceClose         As Integer
    Dim tLocalDevice        As String
    Dim tTempStr            As String

' Change to uppercase and insure the correct format of the local drive letter
    tLocalDevice = UCase$(Left$(tLocalName, 1)) & ":"

' Setup for open file handling
    If nOpenFileAction = NET_OPENIGNORE Then    ' Always dismount
    bForceClose = True
      Else                                      ' Disallow or Warn specified
    bForceClose = False
    End If

' Attempt to drop the connection ...
DismAttempt:
    nResult1 = WNetCancelConnection(tLocalDevice, bForceClose)

' Evaluate the return status of the disconnect
    Select Case nResult1
    Case WN_SUCCESS
        UT_NetDismount = True
    Case WN_OPEN_FILES
        If nOpenFileAction = NET_OPENDISALLOW Then
        MsgBox "There are still open files on the service and it cannot be disconnected. Please close the open files and click 'OK' to dismount the service.", 0, "Network Services"
        GoTo DismAttempt
        End If
        If nOpenFileAction = NET_OPENQUERY Then      ' Warn and prompt
        nAction = MsgBox("There are still open files on the service. Do you want to disconnect anyway?", 4 + 32, "Network Services")
        If nAction = 6 Then                     ' Yes selected
            bForceClose = True
            GoTo DismAttempt
          Else                                  ' No selected
            UT_NetDismount = False
        End If
        End If
    Case Else
        tTempStr = UT_NetError(nResult1)
        MsgBox "An unexpected network error has occurred: " & tTempStr, MB_ICONSTOP, "Network Error"
        UT_NetDismount = False
    End Select

End Function

Function UT_NetError (nErrorCode As Integer) As String

' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.

' This function is passed the network error from a WNet* API function.
' The return string is the text form of the error.

    Dim tMessageText        As String

    Select Case nErrorCode
    Case WN_NOT_SUPPORTED:      tMessageText = "Function is not supported."
    Case WN_OUT_OF_MEMORY:      tMessageText = "Out of memory."
    Case WN_NET_ERROR:          tMessageText = "An error occurred on the network."
    Case WN_BAD_POINTER:        tMessageText = "The pointer was invalid."
    Case WN_BAD_NETNAME:        tMessageText = "Invalid network resource name."
    Case WN_BAD_PASSWORD:       tMessageText = "The password was invalid. Please try again."
    Case WN_BAD_VALUE:          tMessageText = "Invalid local device name."
    Case WN_BAD_LOCALNAME:      tMessageText = "The local device name was invalid."
    Case WN_ACCESS_DENIED:      tMessageText = "The maximum number of users are already connected to this service, or a security has violation occurred. Please try again later."
    Case WN_ALREADY_CONNECTED:  tMessageText = "The local device is already connected to a resource."
    Case WN_NOT_CONNECTED:      tMessageText = "The device is not a redirected network resource."
    Case WN_MORE_DATA:          tMessageText = "More data."
    Case WN_FUNCTION_BUSY:      tMessageText = "Function is already busy."
    Case WN_WINDOWS_ERROR:      tMessageText = "Unexpected Windows error."
    Case WN_BAD_USER:           tMessageText = "The user name is invalid. Please try again."
    Case WN_OUT_OF_MEMORY:      tMessageText = "Out of memory."
    Case WN_OPEN_FILES:         tMessageText = "There are open files on the service."
    Case WN_DEVICE_ERROR:       tMessageText = "A device error occurred."
    Case WN_CONNECTION_CLOSED:  tMessageText = "Connection is closed."
    Case Else
        tMessageText = "Unrecognized Network Error " & Trim$(Str$(nErrorCode)) & "."
    End Select

    UT_NetError = tMessageText

End Function

Function UT_NetGetServiceDrive (tServiceName As String) As String

' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.

' This function returns the drive letter associated with a particular service name.

    Dim tNetworkName        As String
    Dim tTempStr            As String
    Dim nLoopCtr            As Integer

' Loop through the drives looking for the service name
    tTempStr = Trim$(UCase$(tServiceName))
    For nLoopCtr = 4 To 26                  ' Check drives D: to Z:
    On Error Resume Next
    tNetworkName = UT_NetGetServiceName(Chr$(64 + nLoopCtr) & ":")
    On Error GoTo 0
    If tNetworkName = tTempStr Then Exit For
    Next nLoopCtr

' Prepare the return string
    If tNetworkName = tTempStr Then
    UT_NetGetServiceDrive = Chr$(64 + nLoopCtr) & ":"
      Else
    UT_NetGetServiceDrive = ""
    End If

End Function

Function UT_NetGetServiceName (tLocalDrive As String) As String

' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.

' This function returns the name of a service connected to a particular drive.

    Dim tServiceName        As String
    Dim nResult             As Integer
    Dim tTempStr            As String

    If Len(tLocalDrive) = 1 Then tTempStr = tLocalDrive & ":" Else tTempStr = tLocalDrive

' Make the call to get the service information
    tServiceName = Space$(256)              ' Allocate return buffer space
    nResult = WNetGetConnection(tTempStr, tServiceName, 255)

' Evaluate the return and pass back the service name if successful
    Select Case nResult
    Case WN_SUCCESS
        UT_NetGetServiceName = Left$(tServiceName, InStr(tServiceName, Chr$(0)) - 1)
    Case WN_NOT_CONNECTED
        UT_NetGetServiceName = ""
    Case Else
        tTempStr = UT_NetError(nResult)
        MsgBox "An unexpected network error has occurred: " & tTempStr, MB_ICONSTOP, "Network Error"
        UT_NetGetServiceName = ""
    End Select

End Function

Function UT_NetMount (tLocalDrive As String, tServerName As String, tServiceName As String, tPassword As String) As String

' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.

' Inbound parameters:
'   tLocalDrive       the local logical drive letter to use
'   tServerName       the name of the server to connect to
'   tServiceName      the name of the service that we want
'   tPassword         the service tPassword

' Return value:
'   Drive letter that the service is connected to or a NULL string
'   if the mount was not successful.

    Dim nResult             As Integer
    Dim tNetworkPath        As String
    Dim tLocalName          As String
    Dim tTempStr            As String

' Build the network service name from the server and service names
    tNetworkPath = "\\" & Trim$(tServerName) & "\" & Trim$(tServiceName)

' Change to uppercase and insure the correct format of the local drive letter
    tLocalName = UCase$(Left$(tLocalDrive, 1)) & ":"

' Make sure that it is a valid drive letter between A and Z
    If Asc(tLocalName) < 65 Or Asc(tLocalName) > 90 Then
    nResult = MsgBox("An invalid local drive letter was provided to UT_NetMount.", MB_ICONSTOP, "Network Services")
    UT_NetMount = ""
    Exit Function
    End If

' Attempt to mount the service
    nResult = WNetAddConnection(tNetworkPath, tPassword, tLocalName)

' Check the return status
    If nResult = WN_SUCCESS Then
    UT_NetMount = tLocalName
      Else
    tTempStr = UT_NetError(nResult)
    MsgBox "An unexpected network error has occurred: " & tTempStr, MB_ICONSTOP, "Network Error"
    UT_NetMount = ""
    End If

End Function

Function UT_NetUserID () As String

' Copyright ⌐ 1994 by Computer Technologies, Inc. All rights reserved.

' This function gets the name of the user who is currently connected to
' the network from this system. If no user is logged in the routine returns
' a null string.

    Dim tUser               As String
    Dim nStatus             As Integer
    Dim nReturn             As Integer
    Dim tTempStr            As String
    Dim tNetType            As String
    Dim hNetwork            As Integer
    Dim bWFW                As Integer

    tTempStr = ""                   ' Assume user is not logged in
    tUser = Space$(256)             ' Allocate return buffer space

    nStatus = WNetGetUser(tUser, 255)   ' Check for a user name
    If nStatus = 0 Then                 ' Valid call so move data
    tTempStr = Left$(tUser, InStr(tUser, Chr(0)) - 1)
    End If

' If we got a user name all is well ...
    If tTempStr <> "" Then
    UT_NetUserID = tTempStr
    Exit Function
    End If

' We did not get a user ID so see if this is WFW and check the subnets
    bWFW = False
    If InStr((UT_GetNetworkType()), "Workgroups") > 0 Then bWFW = True

    If bWFW = True Then             ' This is Workgroups so loop the subnets
        hNetwork = 0                        ' Set the initial subnet handle
        Do
        nStatus = MNetNetworkEnum(hNetwork)         ' Get a subnet handle
        If nStatus = WN_SUCCESS Then
            nReturn = MNetSetNextTarget(hNetwork)   ' Point to the subnet
            nReturn = WNetGetUser(tUser, 255)       ' Look for a user name
            If nReturn = 0 Then                     ' Got a user name
            tTempStr = Left$(tUser, InStr(tUser, Chr(0)) - 1)
            Exit Do
            End If
        End If
        Loop While nStatus = WN_SUCCESS
    End If

' IF we don't have a user id try once more
'    nStatus = WNetGetUser(tUser, 255)   ' Check for a user name
'    If nStatus = 0 Then                 ' Valid call so move data
'        tTempStr = Left$(tUser, InStr(tUser, Chr(0)) - 1)
'    End If

    UT_NetUserID = tTempStr

End Function